home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / c / cjdates.exe / DTP.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-21  |  5KB  |  134 lines
  1.                  program DTP;
  2.  
  3. {This program illustrates ways in which "dates.tpu" and "dates.inc" can be
  4.  used.  In response to its question "Gimme a date: " you can supply a Day
  5.  Number, a Gregorian date (as mm/dd/yyyy) or a Julian date (as ddd/yyyy).
  6.  Note that the entire year must be given, not just the last two digits.
  7.  The prgram will convert Day Numbers and Julian dates to Gregorian, and will
  8.  validate Gregorian dates, showing you what the back conversion gives.
  9.  To exit the program, just hit ENTER without entering anything.}
  10.  
  11.                         {(c)Copyright 1991 Crazy Jack}
  12.                              {All Rights Reserved}
  13.  {$A+,B-,D-,F-,R-,S-,V-}
  14.  
  15. uses
  16.   Dates,        {--don't forget this!!!}
  17.   Crt;            {---for fastest screen writing.}
  18.  
  19. var
  20.   N         : longint;            {Day number holder.}
  21.   Yi, Mi, Di : word;            {Holders for month, day, & year input.}
  22.   Yo, Mo, D  : word;            {Holders for calculated results.}
  23.   EC, X      : integer;            {Error code and scratch.}
  24.   S          : string[47];        {Holds input string.}
  25.  
  26. {--------------------------YDAY, DOW and MONTHNAME---------------------------}
  27.  
  28.  {$I dates.inc}
  29.  
  30. {------------------------GET AND ANALYZE USER INPUT--------------------------}
  31.  
  32. function GetADate : boolean;        {Reads a date from the user.}
  33.   begin
  34.     Write('Gimme a date: ');        {Pop the question.}
  35.     Readln(S);                {Suck up the reply.}
  36.     if Length(S) < 2            {No reply (or one too short)}
  37.     then                {Means all done.}
  38.       GetADate := FALSE
  39.     else
  40.       begin                {Got something.  What???}
  41.     GetADate := TRUE;
  42.     Val(S, N, EC);            {Convert first number.}
  43.     if EC > 0            {If no error, we just got one number}
  44.     then                {which means a Day Number. Done.}
  45.       begin                {--Otherwise we hit a separator.}
  46.         X := EC;            {Save its location, then}
  47.         Val(Copy(S,1,EC-1),Mi,EC);    {convert number in front. Delete what}
  48.         Delete(S,1,X);        {we just converted PLUS the separator.}
  49.         Val(S,Di,EC);        {Now try to convert what follows the}
  50.         if EC = 0            {separator.  If all is good, we have}
  51.         then            {a Julian date.}
  52.           EC := 1            {Show what we found and we're done.}
  53.         else            {We must have a Gregorian date.}
  54.           begin
  55.         X := EC;        {As before, save location of separator}
  56.         Val(Copy(S,1,EC-1),Di,EC); {Pick up Gregorian month.}
  57.         Delete(S,1,X);        {Delete month and the separator.}
  58.         Val(S,Yi,EC);           {Convert the year.}
  59.         EC := 2            {Flag "Gregorian date".}
  60.           end
  61.       end
  62.       end
  63.   end;                    {Aw dun.}
  64.  
  65. {--------------------------DATE VALIDATION ROUTINES--------------------------}
  66.  
  67. type
  68.   InS = string[4];        {Used by VI and IV to return result.}
  69.  
  70.   function VI : InS;        {Checks a Gregorian date for validity.}
  71.     begin
  72.       VI := ' ';
  73.       if (Mi <> Mo)        {Date is invalid if returned month and/or}
  74.       or (Di <> D)        {day are not the same.}
  75.       then
  76.     VI := 'n in'
  77.     end;
  78.  
  79.   function IV : InS;        {Checks a Julian date for validity.}
  80.     begin
  81.       IV := ' ';                  {Yo, Mo and D were calculated at the "if"}
  82.       Yi := YDay( Yo, Mo, D );    {preceeding the Writeln where IV is allled.}
  83.       if Yi <> Mi          {Date is invalid if returned month and/or}
  84.       then                      {day are not the same.  As a side effect we}
  85.     IV := 'n in'        {return correct day of year in Yi to print.}
  86.     end;            {Pascal calling sequence makes this work.}
  87.  
  88. {---------------------------------MAIN LINE----------------------------------}
  89.  
  90. begin
  91.  
  92.   while GetADate do        {Get date from user.}
  93.     begin
  94.  
  95.       if EC = 0                 {--means we got a Day Number.}
  96.       then
  97.     if ZDate(N, Yo, Mo, D)  {Try converting to Gregorian date.}
  98.     then
  99.       Writeln('Day Number ',N,' is ',DOW( word(N mod 7) ),
  100.             ', ',MonthName(Mo),' ',D,', ',Yo,',',^M^J,
  101.           '     and the Julian date is ',YDay( Yo, Mo, D ),'/',Yo,'.')
  102.     else
  103.       Writeln('Can''t convert Day Number ',N,'.')
  104.  
  105.       else if EC = 1        {--means we got a Julian date.}
  106.       then                      {NOTE:  If we come here, the day of the year}
  107.     begin            {is in Mi and the year is in Di!}
  108.       N := Zday(Di, 1, Mi);        {Conveert to Day Number,}
  109.       if ZDate(N, Yo, Mo, D)    {then convert to Gregorian.}
  110.       then                  {IV will get the day of the year for us.}
  111.         Writeln('A',IV,'valid Julian date Day Number ',N,' which is ',
  112.                 copy(DOW( word(N mod 7) ),1,3),
  113.             ', ',D,' ',copy(MonthName(Mo),1,3),', ',Yo,',',^M^J,
  114.                 '     and the Julian date is ',Yi,'/',Yo,'.')
  115.       else
  116.         Writeln('Can''t convert resulting Day Number ',N,'.')
  117.     end
  118.  
  119.       else            {--means we got a Gregorian date.}
  120.     begin
  121.       N := ZDay(Yi, Mi, Di);    {Convert to Day Number,}
  122.       if ZDate(N, Yo, Mo, D)        {then back to Gregorian.}
  123.       then
  124.         Writeln('A',VI,'valid Gregorian date giving Day Number ',N,
  125.           ' which is ',DOW( word(N mod 7) ),', ',Mo,'/',D,'/',Yo,',',^M^J,
  126.           '     and the Julian date is ',YDay( Yo, Mo, D ),'/',Yo,'.')
  127.       else
  128.         Writeln('Can''t convert that date.')
  129.     end;
  130.  
  131.   end
  132.  
  133. end.
  134.